Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Libraries/Mercutio 1.2b20/Sample Code/Mercutio Test App.p

Text File | 1994-09-29 | 11.6 KB | 424 lines | [TEXT/PJMM]

PROGRAM TestMDEFApp;
    USES
        MercutioAPI, PopupDialog;
    CONST
        lwrX = 120;
        lwrV = 118;
        lwrC = 99;

        appleMenuID = 300;        { Resource ID of the Apple menu }
        fileMenuID = 301;        { Resource ID of the File menu }
        editMenuID = 302;        { Resource ID of the Edit menu }
        modifiersMenuID = 303;
        iconsMenuID = 304;
        nonPrintingMenuID = 305;
        callbackMenuID = 306;
        colorMenuID = 307;

        firstMenu = 300;        { Res ID of first menu in menu bar }
        lastMenu = 307;        { Res ID of last menu in menu bar }

        popupMenuID = 1;
        firstHierMenu = 1;
        lastHierMenu = 1;

        kICONSize = 32;
        kSICNSize = 16;
        svAllLargeData = $000000ff;
        svAllSmallData = $0000ff00;

        addFolderIconID = 262;
        addFoldersIconID = 263;
        addFileIconID = 264;
        addFilesIconID = 265;

    TYPE
        IconSelectorValue = LONGINT;

    VAR
        Finished: Boolean;                { Set to true when were done    }

        normalMenus: ARRAY[firstMenu..lastMenu] OF MenuHandle; { The menus in menu bar    }
        HierMenus: ARRAY[firstHierMenu..lastHierMenu] OF MenuHandle; { The hidden menus    }

        hMDEF: handle;                    { required for PowerMenuKey }




    PROCEDURE ToggleItemCheck (theMenu: MenuHandle; item: Integer);
        VAR
            curMark: char;
    BEGIN
        GetItemMark(theMenu, item, curMark);
        IF curMark = chr(noMark) THEN
            CheckItem(theMenu, item, true) {check it on in menu}
        ELSE
            CheckItem(theMenu, item, false); {check it off in menu}
    END;

{------------------------- process the menu selection --------------------------}

    PROCEDURE ProcessMenu (CodeWord: LongInt);

        VAR
            menuNum: Integer;                { Res ID of the menu Selected    }
            itemNum: Integer;                { The item number selected    }
            nameHolder: str255;            { the name of the desk acc.    }
            dummy: Integer;                { just a dummy            }
            AboutRecord: DialogRecord;    { the actual object        }
            AboutDlog: DialogPtr;            { a pointer to my dialog    }
            tempStr: str255;
    BEGIN
        menuNum := HiWord(CodeWord);    { get the menu number        }
        itemNum := LoWord(CodeWord);    { get the item number        }
        IF itemNum > 0 THEN            { ok to handle the menu?    }
            BEGIN
                CASE MenuNum OF
                    appleMenuID:
                        CASE ItemNum OF
                            1:
                                BEGIN
                                    AboutDlog := GetNewDialog(3000, @AboutRecord, Pointer(-1));
                                    ModalDialog(NIL, dummy);
                                    CloseDialog(AboutDlog);
                                END;
                            2:
                                BEGIN
                                END;
                            OTHERWISE
                                BEGIN
                                    GetItem(normalMenus[appleMenuID], ItemNum, NameHolder);
                                    dummy := OpenDeskAcc(NameHolder);
                                END;
                        END;
                    fileMenuID:
                        CASE itemNum OF
                            1:
                                doPopupDialog(hierMenus[popupMenuID]);
                            3:
                                Finished := true;
                            OTHERWISE
                                ToggleItemCheck(normalMenus[MenuNum], ItemNum);
                        END;
                    editMenuID:
                        IF NOT SystemEdit(ItemNum - 1) THEN
                            BEGIN        {we don't support any editing}
                                ToggleItemCheck(normalMenus[MenuNum], ItemNum);
                            END;
                    firstHierMenu..lastHierMenu:
                        IF ItemNum <> 0 THEN
                            ToggleItemCheck(hierMenus[MenuNum], ItemNum);
                    modifiersMenuID..lastMenu:
                        IF ItemNum <> 0 THEN
                            ToggleItemCheck(normalMenus[MenuNum], ItemNum);
                    OTHERWISE
                        sysbeep(1);
                END;                        { of case menuNum of        }
            END;                            { of if CodeWord...        }
        HiliteMenu(0);
    END;                                { of process menu        }

{------------------------------- Main Event loop -------------------------------}

    PROCEDURE MainEventLoop;
        VAR
            Event: EventRecord;            { Filled by Get next event    }
            windowLoc: integer;            { the mouse location        }
            mouseLoc: point;                { the area it was in        }
            theWindow: WindowPtr;            { Dummy,cause we have no windows}
            matchedItem: longint;
    BEGIN
        REPEAT                            { do this until we selected quit}
            SystemTask;                    { Take care of desk accessories    }
            IF GetNextEvent(everyEvent, Event) THEN    { if there was an event... then    }
                CASE event.what OF            { case out on the event type    }
                    mouseDown:                { we had a mouse-down event    }
                        BEGIN
                            mouseLoc := Event.where;    { wheres the pesky mouse    }
                            windowLoc := FindWindow(mouseLoc, theWindow); { find out where }
                            CASE windowLoc OF    { now case on the location    }
                                inMenuBar:
                                    ProcessMenu(MenuSelect(MouseLoc)); { Handle the selection    }
                                inSysWindow:
                                    SystemClick(Event, theWindow); {It was in a desk acc    }
                                OTHERWISE
                            END;
                        END;
                    keyDown, AutoKey:            { we had the user hit a key    }
                        BEGIN
                            matchedItem := MDEF_MenuKey(Event.message, Event.modifiers, normalMenus[modifiersMenuID]);
                            writeln('menu:', hiWord(matchedItem) : 1, ', item: ', loWord(matchedItem));
                            ProcessMenu(matchedItem);
                        END;
                    OTHERWISE
                END;            { of case event.what...        }
        UNTIL (Finished);    { end of repeat statement    }
    END;                    { of main event loop        }


    PROCEDURE getModifiers (VAR theMods: integer);
        TYPE
            intAsMods = PACKED RECORD
                    b5, b6, b7: boolean;
                    control: boolean;
                    option: boolean;
                    capsLock: boolean;
                    shift: boolean;
                    command: boolean;
                    eventType: char;
                END;
        VAR
            k: keyMap;
    BEGIN
        theMods := 0;
        GetKeys(k);
        WITH intAsMods(theMods) DO
            BEGIN
                control := k[$3B];
                shift := k[$38];
                option := k[$3A];
                command := k[$37];
                capsLock := k[$39];
            END;
    END;


    PROCEDURE MyGetItemInfo (menuID: integer; previousModifiers: integer; VAR itemData: RichItemData);
    { This routine is used by the Callback menu to demonstrate the }
    { Mercutio callback mechanism. This routine is called for every }
    { item in the menu flagged as a "callback item" (in our case, }
    { with the Outline style bit). }
    {}
    { In this example, we check the Shift and Option keys to }
    { determine what the text and icon of the menu item should }
    { be. }
    {}
    { Note the "Dirty" parameter; if we don't change anything}
    { in the menuItem, this parameter should be false to}
    { avoid unnecessary redrawing (and flicker).}
    {}

        VAR
            theErr: osErr;
            modifiers: integer;
            tickStr: str255;
    BEGIN
        getModifiers(modifiers);    { get the user's current modifiers }
        theErr := noErr;

        IF itemData.itemID = 37 THEN
            CASE itemData.cbMsg OF
                cbBasicDataOnlyMsg:
                    BEGIN
                        IF (BitAnd(modifiers, shiftKey) > 0) THEN
                            BEGIN
                                itemData.flags.shiftKey := true;
                                IF (BitAnd(modifiers, optionKey) > 0) THEN
                                    BEGIN
                                        itemData.itemStr := 'Add Folders…';
                                        itemData.flags.optionKey := true;
                                    END
                                ELSE
                                    BEGIN
                                        itemData.itemStr := 'Add Folder…';
                                    END;
                            END
                        ELSE
                            BEGIN
                                IF (BitAnd(modifiers, optionKey) > 0) THEN
                                    BEGIN
                                        itemData.itemStr := 'Add Files…';
                                        itemData.flags.optionKey := true;
                                    END
                                ELSE
                                    BEGIN
                                        itemData.itemStr := 'Add File…';
                                    END
                            END;
                        itemData.flags.hasIcon := true;
                        itemData.flags.changedByCallback := (modifiers <> previousModifiers);
                    END;
                cbIconOnlyMsg:
                    BEGIN
                        IF (BitAnd(modifiers, shiftKey) > 0) THEN
                            IF (BitAnd(modifiers, optionKey) > 0) THEN
                                itemData.hIcon := handle(GetCIcon(AddFoldersIconID))
                            ELSE
                                itemData.hIcon := handle(GetCIcon(AddFolderIconID))
                        ELSE
                            BEGIN
                                IF (BitAnd(modifiers, optionKey) > 0) THEN
                                    itemData.hIcon := handle(GetCIcon(AddFilesIconID))
                                ELSE
                                    itemData.hIcon := handle(GetCIcon(AddFileIconID));
                            END;
                        itemData.flags.hasIcon := true;
                        itemData.iconType := 'cicn';
                        itemData.flags.changedByCallback := (modifiers <> previousModifiers);
                    END;
                OTHERWISE
                    BEGIN
                    END;
            END
        ELSE IF itemData.itemID = 38 THEN
            BEGIN
                CASE itemData.cbMsg OF
                    cbBasicDataOnlyMsg:
                        BEGIN
                            NumToString(TickCount, tickStr);
                            itemData.itemStr := concat('Ticks: ', tickStr);
                            itemData.flags.changedByCallback := true;
                        END;
                    cbIconOnlyMsg:
                        BEGIN
                        END;
                END;
            END;
    END;

{------------------------------ SetUp Everything -------------------------------}

    PROCEDURE SetUpThings;
        TYPE
            ShortPtr = ^integer;
            LongPtr = ^longint;
        VAR
            index: integer;                { used in a for loop        }
            hRes: handle;
            dataPtr: ptr;

            prefs: MenuPrefsRec;
    BEGIN

    { *** load and install the menus *** }
        FOR index := firstMenu TO lastMenu DO    { loop for all menus in menu bar}
            BEGIN
                normalMenus[index] := GetMenu(index);    { Get the next menu        }
                IF index = appleMenuID THEN
                    AddResMenu(normalMenus[appleMenuID], 'DRVR');    { Add desk accessories        }
                InsertMenu(normalMenus[index], 0);
                CalcMenuSize(normalMenus[index]);
            END;

        FOR index := firstHierMenu TO lastHierMenu DO
            BEGIN
                hierMenus[index] := GetMenu(index);
                InsertMenu(hierMenus[index], -1);
                CalcMenuSize(hierMenus[index]);
            END;


    { *** setup the preferences for our menus *** }
    { This is where we determine which style bits are mapped to }
    { MDEF features. Most of the menus use Mercutio's default }
    { settings. These menus are the exceptions. }
    {}
    { Feel free to play with these settings and see how }
    { the menus are affected.}
    {}
    { Note that we could have stored all this information in an}
    { 'Xmnu' resource with the same ID as the menu, and avoided }
    { the hassle of setting these preferences programmatically. }
    { We do it this way to demonstrate the various features of}
    { the MDEF. }

    { *** set up the Color menu *** }
    {        1. the Color menu uses an 'Xmnu' resource }
    {            to restore the Condense and Extend bits to their }
    {           regular functions (as style bits), and sets the }
    {           DEFAULT modifiers to Option-Command. This means }
    {           that key equivalents in this Menu need the Command }
    {           and Option keys held down, but all the style bits}
    {           are still free to be used as such. }
    {}
        WITH prefs DO
            BEGIN
                optionKeyFlag := [];
                shiftKeyFlag := [];
                cmdKeyFlag := [];
                controlKeyFlag := [];
                isDynamicFlag := [];
                forceNewGroupFlag := [];
                useCallbackFlag := [];
                requiredModifiers := cmdKey + optionKey;
            END;
        MDEF_SetMenuPrefs(normalMenus[colorMenuID], @prefs);



    { *** set up the Modifiers menu *** }
    {}
    {    2. the Modifiers menu demonstrates all four }
    {      modifier keys in action. Thus, we need}
    {      to use four style bits, which we }
    {      select and store below.}
    {}
        WITH prefs DO
            BEGIN
                optionKeyFlag := [underline];
                shiftKeyFlag := [extend];
                cmdKeyFlag := [bold];
                controlKeyFlag := [shadow];
                isDynamicFlag := [];
                forceNewGroupFlag := [];
                useCallbackFlag := [outline];
                requiredModifiers := 0;
            END;
        MDEF_SetMenuPrefs(normalMenus[modifiersMenuID], @prefs);



    { *** set up the Callback menu *** }
    { Note that we can make this call regardless of what MDEF we are using, }
    { because if an MDEF doesn't recognize a message (in our case, the }
    { SetCallback message), it simply ignores it.}
    {}
        WITH prefs DO
            BEGIN
                optionKeyFlag := [condense];
                shiftKeyFlag := [extend];
                cmdKeyFlag := [];
                controlKeyFlag := [];
                isDynamicFlag := [outline];
                forceNewGroupFlag := [italic];
                useCallbackFlag := [underline];
                requiredModifiers := cmdKey;
            END;
        MDEF_SetCallbackProc(normalMenus[callbackMenuID], @MyGetItemInfo);
        MDEF_SetMenuPrefs(normalMenus[callbackMenuID], @prefs);

        DrawMenuBar;
    END;





    PROCEDURE Cleanup;
    { loop through all of the menus and release them from memory }
        VAR
            index: integer;
    BEGIN
        FOR index := firstMenu TO lastMenu DO    { loop for all menus in menu bar}
            BEGIN
                DeleteMenu(index);
                ReleaseResource(handle(normalMenus[index]));
            END;
        FOR index := firstHierMenu TO lastHierMenu DO    { loop for all menus in menu bar}
            BEGIN
                DeleteMenu(index);
                ReleaseResource(handle(hierMenus[index]));
            END;
    END;


{------------------------------- Main Program Seg ------------------------------}

BEGIN
    InitCursor;                { make the cursor an arrow    }
    SetUpThings;
    Finished := false;
    MainEventLoop;
    Cleanup;
END.